home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue29 / buffstrm / BUFFSTRM.PAS next >
Encoding:
Pascal/Delphi Source File  |  1997-11-09  |  15.4 KB  |  475 lines
  1. {*********************************************************}
  2. {* BUFFSTRM.PAS                                          *}
  3. {* Copyright (c) Julian M Bucknall 1997                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Buffered Handle and File Stream                       *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit BufFStrm;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils,
  19.   Classes;
  20.  
  21. type
  22.   {$IFDEF Windows}
  23.   TbhsMemSize = word;      {Memory size type}
  24.   {$ELSE}
  25.   TbhsMemSize = integer;
  26.   {$ENDIF}
  27.  
  28. type
  29.   TbhsBufferedHandleStream = class(TStream)
  30.     protected {private}
  31.       bhsPage      : PByteArray; {buffer}
  32.       bhsPageSize  : TbhsMemSize;{size of buffer (multiple of 1K)}
  33.       bhsPageStart : Longint;    {start of buffer as offset in stream}
  34.       bhsPosInPage : TbhsMemSize;{current position in buffer}
  35.       bhsByteCount : TbhsMemSize;{count of valid bytes in buffer}
  36.       bhsSize      : Longint;    {count of bytes in stream}
  37.       bhsHandle    : integer;    {handle of file}
  38.       bhsDirty     : boolean;    {whether the buffer is dirty or not}
  39.       bhsMustFlush : boolean;    {whether to flush on disk write}
  40.     protected
  41.       procedure bhsReadBuffer;
  42.       procedure bhsWriteBuffer;
  43.     public
  44.       constructor Create(aHandle : integer; aBufSize : TbhsMemSize);
  45.         {-create the buffered handle stream}
  46.       destructor Destroy; override;
  47.         {-destroy the buffered handle stream}
  48.  
  49.       function Read(var Buffer; Count : Longint) : Longint; override;
  50.         {-read from the stream into a buffer}
  51.       function Write(const Buffer; Count : Longint) : Longint; override;
  52.         {-write to the stream from a buffer}
  53.       function Seek(Offset : Longint; Origin : Word) : Longint; override;
  54.         {-seek to a particular point in the stream}
  55.       procedure Commit;
  56.         {-ensures that all buffered data is flushed to disk}
  57.  
  58.       procedure SetSize(NewSize : Longint); {$IFDEF Ver100} override; {$ENDIF}
  59.         {-set the stream size}
  60.  
  61.       property MustFlush : boolean
  62.          read bhsMustFlush write bhsMustFlush;
  63.         {-Whether to flush the file handle after a write operation}
  64.   end;
  65.  
  66. type
  67.   TbfsBufferedFileStream = class(TbhsBufferedHandleStream)
  68.     protected {private}
  69.       bfsFileName : string;
  70.     public
  71.       constructor Create(const aFileName : string;
  72.                                aOpenMode : word;
  73.                                aBufSize : TbhsMemSize);
  74.         {-create the buffered file stream}
  75.       destructor Destroy; override;
  76.         {-destroy the buffered file stream}
  77.  
  78.       property FileName : string
  79.         {-the name of the file on disk}
  80.          read bfsFileName;
  81.   end;
  82.  
  83. implementation
  84.  
  85. uses
  86.   {$IFDEF Windows}
  87.   WinTypes, WinProcs;
  88.   {$ELSE}
  89.   Windows;
  90.   {$ENDIF}
  91.  
  92. {===Helper routines==================================================}
  93. procedure RaiseException(const S : string);
  94. begin
  95.   raise Exception.Create(S);
  96. end;
  97. {--------}
  98. procedure FileFlush(aHandle : integer);
  99. {$IFDEF Windows}
  100. var
  101.   DosError : word;
  102. begin
  103.   asm
  104.     mov ah, $68
  105.     mov bx, aHandle
  106.     call DOS3Call
  107.     jc @@Error
  108.     xor ax, ax
  109.   @@Error:
  110.     mov DosError, ax
  111.   end;
  112.   if (DosError <> 0) then
  113.     RaiseException('BUFFSTRM.FileFlush: flush failed')
  114. end;
  115. {$ELSE}
  116. begin
  117.   if not FlushFileBuffers(aHandle) then
  118.     RaiseException('BUFFSTRM.FileFlush: flush failed')
  119. end;
  120. {$ENDIF}
  121. {--------}
  122. procedure FileTruncate(aHandle : integer; aOffset : Longint);
  123. {$IFDEF Windows}
  124. var
  125.   SeekResult : Longint;
  126.   DosError   : word;
  127. begin
  128.   SeekResult := FileSeek(aHandle, aOffset, 0);
  129.   if (SeekResult = -1) then
  130.     RaiseException('BUFFSTRM.FileTruncate: seek failed');
  131.   asm
  132.     push ds
  133.     mov ah, $40
  134.     mov bx, aHandle
  135.     xor cx, cx
  136.     mov ds, cx
  137.     mov dx, cx
  138.     call DOS3Call
  139.     pop ds
  140.     jc @@Error
  141.     xor ax, ax
  142.   @@Error:
  143.     mov DosError, ax
  144.   end;
  145.   if (DosError <> 0) then
  146.     RaiseException('BUFFSTRM.FileTruncate: set end of file failed')
  147. end;
  148. {$ELSE}
  149. var
  150.   SeekResult : Longint;
  151. begin
  152.   SeekResult := FileSeek(aHandle, aOffset, 0);
  153.   if (SeekResult = -1) then
  154.     RaiseException('BUFFSTRM.FileTruncate: seek failed');
  155.   if not SetEndOfFile(aHandle) then
  156.     RaiseException('BUFFSTRM.FileTruncate: set end of file failed')
  157. end;
  158. {$ENDIF}
  159. {====================================================================}
  160.  
  161.  
  162. {===TbhsBufferedHandleStream=========================================}
  163. constructor TbhsBufferedHandleStream.Create(aHandle  : integer;
  164.                                             aBufSize : TbhsMemSize);
  165. var
  166.   ActBufSize : Longint;
  167. begin
  168.   inherited Create;
  169.   {save the handle}
  170.   bhsHandle := aHandle;
  171.   {round up the buffer size to a multiple of 1K and a maximum of 32K}
  172.   ActBufSize := (Longint(aBufSize) + 1023) and $FFFFFC00;
  173.   if (ActBufSize > 32 * 1024) then
  174.     bhsPageSize := 32 * 1024
  175.   else
  176.     bhsPageSize := ActBufSize;
  177.   {create the buffer}
  178.   GetMem(bhsPage, bhsPageSize);
  179.   {set the page/buffer variables to the start of the stream}
  180.   bhsPosInPage := 0;
  181.   bhsByteCount := 0;
  182.   bhsPageStart := 0;
  183.   bhsDirty := false;
  184.   bhsSize := FileSeek(aHandle, 0, soFromEnd);
  185.   if (bhsSize = -1) then
  186.     RaiseException('TbhsBufferedHandleStream.Create: seek EOF failed');
  187. end;
  188. {--------}
  189. destructor TbhsBufferedHandleStream.Destroy;
  190. begin
  191.   {destroy the buffer, if need be after writing it to disk}
  192.   if (bhsPage <> nil) then begin
  193.     Commit;
  194.     FreeMem(bhsPage, bhsPageSize);
  195.   end;
  196.   {let our ancestor clean up}
  197.   inherited Destroy;
  198. end;
  199. {--------}
  200. procedure TbhsBufferedHandleStream.bhsReadBuffer;
  201. var
  202.   SeekResult : Longint;
  203. begin
  204.   SeekResult := FileSeek(bhsHandle, bhsPageStart, 0);
  205.   if (SeekResult = -1) then
  206.     RaiseException('TbhsBufferedHandleStream.bhsReadBuffer: seek failed');
  207.   bhsByteCount := FileRead(bhsHandle, bhsPage^, bhsPageSize);
  208.   if (bhsByteCount <= 0) then
  209.     RaiseException('TbhsBufferedHandleStream.bhsReadBuffer: read failed');
  210. end;
  211. {--------}
  212. procedure TbhsBufferedHandleStream.bhsWriteBuffer;
  213. var
  214.   SeekResult : Longint;
  215.   BytesWrit  : Longint;
  216. begin
  217.   SeekResult := FileSeek(bhsHandle, bhsPageStart, 0);
  218.   if (SeekResult = -1) then
  219.     RaiseException('TbhsBufferedHandleStream.bhsWriteBuffer: seek failed');
  220.   BytesWrit := FileWrite(bhsHandle, bhsPage^, bhsByteCount);
  221.   if (BytesWrit <> bhsByteCount) then
  222.     RaiseException('TbhsBufferedHandleStream.bhsWriteBuffer: write failed');
  223.   if MustFlush then
  224.     FileFlush(bhsHandle);
  225. end;
  226. {--------}
  227. procedure TbhsBufferedHandleStream.Commit;
  228. begin
  229.   if bhsDirty then begin
  230.     bhsWriteBuffer;
  231.     bhsDirty := false;
  232.   end;
  233.   FileFlush(bhsHandle);
  234. end;
  235. {--------}
  236. function TbhsBufferedHandleStream.Read(var Buffer; Count : Longint) : Longint;
  237. var
  238.   BufAsBytes  : TByteArray absolute Buffer;
  239.   BufInx      : Longint;
  240.   BytesToGo   : Longint;
  241.   BytesToRead : integer;
  242. begin
  243.   {reading is complicated by the fact we can only read in chunks of
  244.    bhsPageSize: we need to partition out the overall read into a
  245.    read from part of the buffer, zero or more reads from complete
  246.    buffers and then a possible read from part of a buffer}
  247.  
  248.   {$IFDEF Windows}
  249.   {in Delphi 1 we do not support reads greater than 65535 bytes}
  250.   if (Count > $FFFF) then
  251.     RaiseException('TbhsBufferedHandleStream.Read: requested too many bytes');
  252.   {$ENDIF}
  253.  
  254.   {calculate the actual number of bytes we can read - this depends on
  255.    the current position and size of the stream as well as the number
  256.    of bytes requested}
  257.   BytesToGo := Count;
  258.   if (bhsSize < (bhsPageStart + bhsPosInPage + Count)) then
  259.     BytesToGo := bhsSize - (bhsPageStart + bhsPosInPage);
  260.   if (BytesToGo <= 0) then begin
  261.     Result := 0;
  262.     Exit;
  263.   end;
  264.   {remember to return the result of our calculation}
  265.   Result := BytesToGo;
  266.  
  267.   {initialise the byte index for the caller's buffer}
  268.   BufInx := 0;
  269.   {is there anything in the buffer? if not, go read something from
  270.    the file on disk}
  271.   if (bhsByteCount = 0) then
  272.     bhsReadBuffer;
  273.   {calculate the number of bytes we can read prior to the loop}
  274.   BytesToRead := bhsByteCount - bhsPosInPage;
  275.   if (BytesToRead > BytesToGo) then
  276.     BytesToRead := BytesToGo;
  277.   {copy from the stream buffer to the caller's buffer}
  278.   Move(bhsPage^[bhsPosInPage], BufAsBytes[BufInx], BytesToRead);
  279.   {calculate the number of bytes still to read}
  280.   dec(BytesToGo, BytesToRead);
  281.  
  282.   {while we have bytes to read, read them}
  283.   while (BytesToGo > 0) do begin
  284.     {advance the byte index for the caller's buffer}
  285.     inc(BufInx, BytesToRead);
  286.     {as we've exhausted this buffer-full, advance to the next, check
  287.      to see whether we need to write the buffer out first}
  288.     if bhsDirty then begin
  289.       bhsWriteBuffer;
  290.       bhsDirty := false;
  291.     end;
  292.     inc(bhsPageStart, bhsPageSize);
  293.     bhsPosInPage := 0;
  294.     bhsReadBuffer;
  295.     {calculate the number of bytes we can read in this cycle}
  296.     BytesToRead := bhsByteCount;
  297.     if (BytesToRead > BytesToGo) then
  298.       BytesToRead := BytesToGo;
  299.     {copy from the stream buffer to the caller's buffer}
  300.     Move(bhsPage^, BufAsBytes[BufInx], BytesToRead);
  301.     {calculate the number of bytes still to read}
  302.     dec(BytesToGo, BytesToRead);
  303.   end;
  304.   {remember our new position}
  305.   inc(bhsPosInPage, BytesToRead);
  306.   if (bhsPosInPage = bhsPageSize) then begin
  307.     inc(bhsPageStart, bhsPageSize);
  308.     bhsPosInPage := 0;
  309.     bhsByteCount := 0;
  310.   end;
  311. end;
  312. {--------}
  313. function TbhsBufferedHandleStream.Seek(Offset : Longint;
  314.                                        Origin : Word) : Longint;
  315. var
  316.   NewPageStart : Longint;
  317.   NewPos       : Longint;
  318. begin
  319.   {calculate the new position}
  320.   case Origin of
  321.     soFromBeginning : NewPos := Offset;
  322.     soFromCurrent   : NewPos := bhsPageStart + bhsPosInPage + Offset;
  323.     soFromEnd       : NewPos := bhsSize + Offset;
  324.   else
  325.     NewPos := 0;
  326.     RaiseException('TbhsBufferedHandleStream.Seek: invalid origin');
  327.   end;
  328.   if (NewPos < 0) or (NewPos > bhsSize) then
  329.     RaiseException('TbhsBufferedHandleStream.Seek: invalid new position');
  330.   {calculate which page of the file we need to be at}
  331.   NewPageStart := NewPos and not(pred(longint(bhsPageSize)));
  332.   {if the new page is different than the old, mark the buffer as being
  333.    ready to be replenished, and if need be write out any dirty data}
  334.   if (NewPageStart <> bhsPageStart) then begin
  335.     if bhsDirty then begin
  336.       bhsWriteBuffer;
  337.       bhsDirty := false;
  338.     end;
  339.     bhsPageStart := NewPageStart;
  340.     bhsByteCount := 0;
  341.   end;
  342.   {save the new position}
  343.   bhsPosInPage := NewPos - NewPageStart;
  344.   Result := NewPos;
  345. end;
  346. {--------}
  347. procedure TbhsBufferedHandleStream.SetSize(NewSize : Longint);
  348. begin
  349.   {save the new size and alter the position if required}
  350.   bhsSize := NewSize;
  351.   if ((bhsPageStart + bhsPosInPage) > NewSize) then
  352.     Seek(0, soFromEnd);
  353.   {now truncate/extend the file handle}
  354.   FileTruncate(bhsHandle, NewSize);
  355. end;
  356. {--------}
  357. function TbhsBufferedHandleStream.Write(const Buffer; Count : Longint) : Longint;
  358. var
  359.   BufAsBytes  : TByteArray absolute Buffer;
  360.   BufInx      : Longint;
  361.   BytesToGo   : Longint;
  362.   BytesToWrite: integer;
  363. begin
  364.   {writing is complicated by the fact we write in chunks of
  365.    bhsPageSize: we need to partition out the overall write into a
  366.    write from part of the buffer, zero or more writes from complete
  367.    buffers and then a possible write from part of a buffer}
  368.  
  369.   {$IFDEF Windows}
  370.   {in Delphi 1 we do not support writes greater than 65535 bytes}
  371.   if (Count > $FFFF) then
  372.     RaiseException('TbhsBufferedHandleStream.Write: requested too many bytes');
  373.   {$ENDIF}
  374.  
  375.   {when we write to this stream we always assume that we can write the
  376.    requested number of bytes: if we can't (eg, the disk is full) we'll
  377.    get an exception somewhere eventually}
  378.   BytesToGo := Count;
  379.   {remember to return the result of our calculation}
  380.   Result := BytesToGo;
  381.  
  382.   {initialise the byte index for the caller's buffer}
  383.   BufInx := 0;
  384.   {is there anything in the buffer? if not, go try read a block from
  385.    the file on disk - we might be overwriting existing data rather
  386.    than appending data to the end of the stream}
  387.   if (bhsByteCount = 0) and (bhsSize > bhsPageStart) then
  388.     bhsReadBuffer;
  389.   {calculate the number of bytes we can write prior to the loop}
  390.   BytesToWrite := bhsPageSize - bhsPosInPage;
  391.   if (BytesToWrite > BytesToGo) then
  392.     BytesToWrite := BytesToGo;
  393.   {copy from the caller's buffer to the stream buffer}
  394.   Move(BufAsBytes[BufInx], bhsPage^[bhsPosInPage], BytesToWrite);
  395.   {mark the stream buffer as requiring a save to disk, note that this
  396.    will suffice for the rest of the routine as well: no inner routine
  397.    will turn off the dirty flag}
  398.   bhsDirty := true;
  399.   {calculate the number of bytes still to write}
  400.   dec(BytesToGo, BytesToWrite);
  401.  
  402.   {while we have bytes to write, write them}
  403.   while (BytesToGo > 0) do begin
  404.     {advance the byte index for the caller's buffer}
  405.     inc(BufInx, BytesToWrite);
  406.     {as we've filled this buffer, write it out to disk and advance to
  407.      the next buffer, reading it if required}
  408.     bhsByteCount := bhsPageSize;
  409.     bhsWriteBuffer;
  410.     inc(bhsPageStart, bhsPageSize);
  411.     bhsPosInPage := 0;
  412.     bhsByteCount := 0;
  413.     if (bhsSize > bhsPageStart) then
  414.       bhsReadBuffer;
  415.     {calculate the number of bytes we can write in this cycle}
  416.     BytesToWrite := bhsPageSize;
  417.     if (BytesToWrite > BytesToGo) then
  418.       BytesToWrite := BytesToGo;
  419.     {copy from the caller's buffer to the stream buffer}
  420.     Move(BufAsBytes[BufInx], bhsPage^, BytesToWrite);
  421.     {calculate the number of bytes still to write}
  422.     dec(BytesToGo, BytesToWrite);
  423.   end;
  424.   {remember our new position}
  425.   inc(bhsPosInPage, BytesToWrite);
  426.   {make sure the count of valid bytes is correct}
  427.   if (bhsByteCount < bhsPosInPage) then
  428.     bhsByteCount := bhsPosInPage;
  429.   {make sure the stream size is correct}
  430.   if (bhsSize < (bhsPageStart + bhsByteCount)) then
  431.     bhsSize := bhsPageStart + bhsByteCount;
  432.   {if we're at the end of the buffer, write it out and advance to the
  433.    start of the next page}
  434.   if (bhsPosInPage = bhsPageSize) then begin
  435.     bhsWriteBuffer;
  436.     bhsDirty := false;
  437.     inc(bhsPageStart, bhsPageSize);
  438.     bhsPosInPage := 0;
  439.     bhsByteCount := 0;
  440.   end;
  441. end;
  442. {====================================================================}
  443.  
  444.  
  445. {===TbfsBufferedFileStream===========================================}
  446. constructor TbfsBufferedFileStream.Create(const aFileName : string;
  447.                                                 aOpenMode : word;
  448.                                                 aBufSize : TbhsMemSize);
  449. var
  450.   Handle : THandle;
  451. begin
  452.   if (aOpenMode = fmCreate) then begin
  453.     Handle := FileCreate(aFileName);
  454.     if (Handle <= 0) then
  455.       RaiseException('TbfsBufferedFileStream.Create: cannot create file');
  456.   end
  457.   else begin
  458.     Handle := FileOpen(aFileName, aOpenMode);
  459.     if (Handle <= 0) then
  460.       RaiseException('TbfsBufferedFileStream.Create: cannot open file');
  461.   end;
  462.   inherited Create(Handle, aBufSize);
  463.   bfsFileName := ExpandFileName(aFileName);
  464. end;
  465. {--------}
  466. destructor TbfsBufferedFileStream.Destroy;
  467. begin
  468.   inherited Destroy;
  469.   if (bhsHandle > 0) then
  470.     FileClose(bhsHandle);
  471. end;
  472. {====================================================================}
  473.  
  474. end.
  475.